MacFormat 1996 November/macformat-043.iso/mac/Shareware Plus/Developers/Sprite Animation Toolkit 2.3.8/Add-ons/Storage/Preferences.p

Text File | 1996-05-23 | 6.8 KB | 237 lines | [TEXT/PJMM]

{Preferences file handling}

{Principle: If we can write in the app itself, we do, but if not, or if there is already}
{a prefs file, we use a pref file in the system folder. (The idea is that it is very elegant}
{to save prefs in the application, whenever that is allowable.)}

{New version (march -94), stand-alone, takes file name and type as parameters,}
{can be forced to create a pref file, includes resource copying routine.}
{Newer, summer -95: no globals. Cleaned up some more.}

{What can we improve? Check the "shared" flag and set alwaysExternal if it is set?}

unit Preferences;

{Special thanks to Peter Lewis, who made and released source-code to DeHQX v2.0.0 © Peter Lewis, Aug 1991 }

interface

{$IFC UNDEFINED THINK_PASCAL}
    uses
        Types, QuickDraw, Fonts, Events, Packages, Menus, Dialogs, Windows,{}
        OSUtils, ToolUtils, Resources, Folders, Files, Memory, Errors;
{$ENDC}

    function SetPrefFile (prefsFileName: Str255; prefCreator, prefType: OSType; var appFile, prefFile: Integer; alwaysExternal: Boolean): Boolean;
{Open the pref file if needed. Return the variables appFile and prefFile.}
{If alwaysExternal is true, we always want a pref file in the system folder even if we can save in the application.}
{Returns true if a new prefFile was created.}

{Copy a resource from one file to another. Useful when SetPrefFile returns true!}
    function CopyResource (fromFile, toFile: integer; theResType: ResType; id: integer): OSErr;

implementation

{ 1) Find the Preferences folder}
{ 2) Kolla om prefsfil existerar. I så fall, öppna den och gå till 6. }
{ 3) Get a resource and change it with ChangeResource. If it worked, go to 6.}
{ 4) Create a pref file and open it.}
{ 5) Get resources from the app and copy to the pref file.}
{ 6) Get resources, create if they don't exist.}

    var
        sysEnv: SysEnvRec;

{$IFC UNDEFINED THINK_PASCAL}
{$ELSEC}
    const
{ From Folders:}
        kPreferencesFolderType = 'pref';        {preferences for applications go here}

{ From Folders:}
    function FindFolder (vRefNum: INTEGER; folderType: OSType; createFolder: BOOLEAN; var foundVRefNum: INTEGER; var foundDirID: LONGINT): OSErr;
    inline
        $7000, $A823;
{$ENDC}

    function GetDirID (wdrn: integer; var vrn: integer; var dirID: longInt): OSErr;
        var
            procID: longInt;
            oe: OSErr;
    begin
        oe := GetWDInfo(wdrn, vrn, dirID, procID);
        if oe <> noErr then
            begin
                vrn := wdrn;
                dirID := 0;
            end;
        GetDirID := oe;
    end;

    function GetPrefsFolder (var ovrn: integer): OSErr;
        var
            vrn: integer;
            sDirID: longint;
            oe: OSErr;
            pb: WDPBRec;
            oDirID: longint; {förr var-deklarerad utvariabel}
            oVolID: integer;{förr var-deklarerad utvariabel}
    begin
        vrn := sysEnv.sysVRefNum;
        if sysEnv.systemVersion >= $0700 then {System7}
            begin
                sDirID := 0;
                oe := GetDirID(vrn, vrn, sDirID);
                oe := FindFolder(vrn, kPreferencesFolderType, true, oVolID, oDirID);

{Convert FindFolders volref+dirid to WDref}
                pb.ioVRefNum := oVolID;
                pb.ioWDProcID := longint('ERIK');
                pb.ioWDDirID := oDirID;
                pb.ioWDIndex := 0;
                pb.ioNamePtr := nil;
                pb.ioCompletion := nil;
{$IFC UNDEFINED THINK_PASCAL}
                oe := PBOpenWDSync(@pb);
{$ELSEC}
                oe := PBOpenWD(@pb, false);
{$ENDC}
                ovrn := pb.ioVRefNum; {WDRefNum}
            end
        else
            begin
                ovrn := vrn;
                oe := NoErr;
            end;
        GetPrefsFolder := oe;
    end;

    function SetPrefFile (prefsFileName: Str255; prefCreator, prefType: OSType; var appFile, prefFile: Integer; alwaysExternal: Boolean): Boolean;
        var
            err: OSErr;
            prefsFolder: integer;
            h: handle;
            s: str255;
    begin
        err := SysEnvirons(1, sysEnv);
        appFile := CurResFile; {save the resfile of the app}
        prefFile := 0;
        SetPrefFile := false;
{ 1) Find Preferencefolder}
        err := GetPrefsFolder(prefsFolder);
        if err <> NoErr then
            ;
{ReportStr('Error finding system folder.')}

{ 2) If preffile exists, open it and go to 6. }
        prefFile := OpenRFPerm(prefsFileName, prefsFolder, FSRdWrPerm);
        if ResError = noErr then
            begin
{Consider checking preffile versionnumber!}
            end
        else
            begin
                prefFile := 0;

{ 3) Get a resource and change it with ChangeResource. If it worked, go to 6.}
{If alwaysExternal is true, we don't have to check.}
                if not alwaysExternal then
                    begin
                        h := Get1Resource(prefCreator, 0); {The program always has a signature if it has a BNDL.}
                        if h = nil then
                            begin
{ReportStr('Resource missing!');}
                            end;
                        ChangedResource(h);
                        alwaysExternal := ResError <> noErr; {Note that alwaysExternal is changed here to signal the descision to create a new pref file!}
                        ReleaseResource(h); {Done with the resource}
                    end;

                if alwaysExternal then
                    begin
{ 4) Create a pref file and open it.}
                        err := Create(PrefsFileName, PrefsFolder, PrefCreator, PrefType);
                        if err = noErr then
                            begin
                                HCreateResFile(PrefsFolder, 0, PrefsFileName);
                                if ResError <> noErr then
                                    begin
{ReportStr('Couldn''t create resource fork!');}
                                    end
                                else
                                    prefFile := OpenRFPerm(PrefsFileName, PrefsFolder, FSRdWrPerm);

                                if ResError = noErr then
                                    SetPrefFile := true; {new pref file!}
{ 5) Get resources from the app and copy to the pref file.}
{Done by your app when SetPrefFile returns true!}
                            end{Create succeded}
                        else
{ReportStr('Failed to create prefsfile!')}
                            ;
                    end; {App write protected.}
            end; {Pref file didn't exist}
{ 6) Get resources, create if they don't exist.}
{Done by your app.}
    end; {SetPrefFile}


{Copy resource:}
    function CopyResource (fromFile, toFile: integer; theResType: ResType; id: integer): OSErr;
        var
            oldResFile: integer;
            res, rescopy: Handle;
            wasLoaded: Boolean;
            theID: integer;
            theType: ResType;
            theName: Str255;
        procedure Barf;
        begin
            CopyResource := ResError;
            UseResFile(oldResFile); {restore}
            exit(CopyResource);
        end;
        procedure CheckError;
        begin
            if ResError <> noErr then
                Barf;
        end; {CheckError}
    begin
        oldResFile := CurResFile;
        UseResFile(fromFile);
        CheckError;

        SetResLoad(false);
        res := Get1Resource(theResType, id);
{CheckError doesn't work here, since we always must do SetResLoad(true)!!!}
        SetResLoad(true);
        CheckError;
        if res <> nil then
            begin
                wasLoaded := res^ = nil;
                LoadResource(res);
                CheckError;
                UseResFile(toFile);
                CheckError;
                GetResInfo(res, theID, theType, theName);
                CheckError;
                rescopy := res;
                if HandToHand(rescopy) <> noErr then
                    Barf; {instead of DetachResource(res);}
                CheckError;
                AddResource(rescopy, theResType, id, theName);
                CheckError;
                ReleaseResource(rescopy);
                if not wasLoaded then
                    ReleaseResource(res); {If it wasn't loaded, we don't leave it loaded.}
                CheckError;
                CopyResource := noErr;
            end
        else
            begin
                CopyResource := resNotFound;
            end;
        UseResFile(oldResFile);
    end; {CopyResource}

end.